unit uCursors;
(*

  Wrapper for the (different) cursor animations

*)
interface

Uses Classes,
     Windows,
     Graphics,

     SysUtils,

     uServices
     ;

Const serviceCursors = 'Cursors';

(* This is the base class for all cursors *)
Type CCursor = Class( CServiceProvider )
       Procedure DrawCursor( aCanvas : TCanvas; aColor : TColor; const Cell : TRect; aFocused : Boolean ); virtual; abstract;
       (* Draws the cursor in its current state *)
       Function AnimateCursor( var NextInterval : LongInt ) : Boolean; virtual;
       (* Animates the cursor one step further. Returns true, if the cursor should
          be redrawn *)
     End;

(* The magic invisible cursor *)
Type CInvisibleCursor = Class( CCursor )
       Procedure DrawCursor( aCanvas : TCanvas; aColor : TColor; const Cell : TRect; aFocused : Boolean ); override;
     End;

(* A simple two-state cursor *)
Type CBlinkingCursor = Class( CCursor )
       Visible : Boolean;
       Function Interval : Integer; virtual;
       Function AnimateCursor( var NextInterval : LongInt ) : Boolean; override;
     End;

(* A simple block cursor *)
Type CBlockCursor = Class( CBlinkingCursor )
       Procedure DrawCursor( aCanvas : TCanvas; aColor : TColor; const Cell : TRect; aFocused : Boolean ); override;
     End;

Type CHLineCursor = Class( CCursor )
       Position : Integer;
       Incr : Integer;

       Constructor Create; override;
       Procedure DrawCursor( aCanvas : TCanvas; aColor : TColor; const Cell : TRect; aFocused : Boolean ); override;
       Function AnimateCursor( var NextInterval : LongInt ) : Boolean; override;
     End;

Type CBarCursor = Class( CBlinkingCursor )
       Procedure DrawCursor( aCanvas : TCanvas; aColor : TColor; const Cell : TRect; aFocused : Boolean ); override;
     End;

Type CConsoleCursor = Class( CBlinkingCursor )
       Procedure DrawCursor( aCanvas : TCanvas; aColor : TColor; const Cell : TRect; aFocused : Boolean ); override;
     End;

(* The classic spinning cursor, even if it's not blinking, it's still derived from CBlinkingCursor *)
Type CSpinnerCursor = Class( CCursor )
       fCurrState : Integer;
       Procedure DrawCursor( aCanvas : TCanvas; aColor : TColor; const Cell : TRect; aFocused : Boolean ); override;
       Function AnimateCursor( var NextInterval : LongInt ) : Boolean; override;
     End;

(* An Xterm style cursor *)
Type CXtermCursor = Class( CCursor )
       Procedure DrawCursor( aCanvas : TCanvas; aColor : TColor; const Cell : TRect; aFocused : Boolean ); override;
     End;
     
implementation

Uses uMainWindow;

Function CCursor.AnimateCursor;
Begin
  AnimateCursor := False;
  NextInterval := 0;
End;

Procedure CInvisibleCursor.DrawCursor;
Begin
End;

Procedure CXtermCursor.DrawCursor;
Begin
  aCanvas.Brush.Color := aColor;
  If aFocused
    then aCanvas.FillRect( Cell )
    else With Cell do
      aCanvas.FrameRect( Cell );
End;

Function CBlinkingCursor.AnimateCursor;
Begin
  Visible := not Visible;
  NextInterval := Interval;
  Result := True;
End;

Function CBlinkingCursor.Interval;
Begin
  Interval := 500;
End;

Procedure CBlockCursor.DrawCursor;
Begin
  If Visible and aFocused
    then
      Begin
        aCanvas.Brush.Color := aColor;
        aCanvas.FillRect( Cell );
      End;
End;

Procedure CBarCursor.DrawCursor;
Var R : TRect;
Begin
  If Visible and aFocused
    then
      Begin
        With Cell do
          R := Rect( Left, Top, Left +1, Bottom );
        aCanvas.Brush.Color := aColor;
        aCanvas.FillRect( R );
      End;
End;

Constructor CHLineCursor.Create;
Begin
  inherited Create;
  Incr := 10;
End;

Procedure CHLineCursor.DrawCursor;
Var LineRect : TRect;
Begin
  If aFocused
    then
      Begin
        With LineRect do
          Begin
            Top := Cell.Top + ( Cell.Bottom - Cell.Top ) * Position div 100;
            Bottom := Cell.Top + ( Cell.Bottom - Cell.Top ) * ( Position+10 ) div 100;
            Left := Cell.Left;
            Right := Cell.Right;
          End;
        aCanvas.Brush.Color := aColor;
        aCanvas.FillRect( LineRect );
      End;
End;

Function CHLineCursor.AnimateCursor;
Begin
  If (Position = 90)
    then
      Begin
        Incr := -10;
        Position := Position + Incr;
      End
    else
  If (Position = 0)
    then
      Begin
        Incr := 10;
        Position := Position + Incr;
      End
    else Position := Position + Incr;
  NextInterval := 100;
  AnimateCursor := True;
End;

Procedure CConsoleCursor.DrawCursor;
Var LineRect : TRect;
    CursorSize : TConsoleCursorInfo;
    Console : THandle;
Begin
  If Visible and aFocused
    then
      Begin
        Console := CreateFile( 'CONOUT$', GENERIC_WRITE or GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
        If not GetConsoleCursorInfo( Console, CursorSize )
          then RaiseLastWin32Error;
        LineRect := Cell;
        With LineRect do
          Top := Cell.Top + ( Cell.Bottom - Cell.Top ) * (100-CursorSize.dwSize) div 100;
        aCanvas.Brush.Color := aColor;
        aCanvas.FillRect( LineRect );
        CursorSize.dwSize := 100;
        {If not SetConsoleCursorInfo( Console, CursorSize )
          then RaiseLastWin32Error;}
        CloseHandle( Console );
      End;
End;

Function CSpinnerCursor.AnimateCursor;
Begin
  Result := True;
  NextInterval := 200;
  fCurrState := Succ(fCurrState) mod 4;
End;

Procedure CSpinnerCursor.DrawCursor;
Var StartPoint : TPoint;
    EndPoint : TPoint;
    Adj : Integer;
Begin
  If aFocused
    then
      Begin
        aCanvas.Pen.Width := 2;
        Adj := aCanvas.Pen.Width div 2;
        If Adj = 0 then Adj := 1;

        Case fCurrState of
          0 : Begin
                With Cell do
                  Begin
                    StartPoint.X := Left + Adj;
                    StartPoint.Y := Top+Adj;
                    EndPoint.X := Right-Adj;
                    EndPoint.Y := Bottom-Adj;
                  End;
              End;
          1 : Begin
                With Cell do
                  Begin
                    StartPoint.X := Left + (Right - Left) div 2;
                    StartPoint.Y := Top+Adj;
                    EndPoint.X := StartPoint.X;
                    EndPoint.Y := Bottom-Adj;
                  End;
              End;
          2 : Begin
                With Cell do
                  Begin
                    StartPoint.X := Right-Adj;
                    StartPoint.Y := Top+Adj;
                    EndPoint.X := Left+Adj;
                    EndPoint.Y := Bottom-Adj;
                  End;
              End;
          3 : Begin
                With Cell do
                  Begin
                    StartPoint.X := Left+Adj;
                    StartPoint.Y := Top + (Bottom - Top) div 2;
                    EndPoint.X := Right-Adj;
                    EndPoint.Y := StartPoint.Y;
                  End;
              End;
        End;
        aCanvas.Pen.Style := psSolid;
        aCanvas.Pen.Color := aColor;
        aCanvas.MoveTo( StartPoint.X, StartPoint.Y );
        aCanvas.LineTo( EndPoint.X, EndPoint.Y );
      End;
End;

initialization
  ServiceManager.RegisterService( serviceCursors, 'No cursor', CInvisibleCursor );
  ServiceManager.RegisterService( serviceCursors, 'Block cursor', CBlockCursor );
  ServiceManager.RegisterService( serviceCursors, 'Horizontal line cursor', CHLineCursor);
  ServiceManager.RegisterService( serviceCursors, 'Bar cursor', CBarCursor);
  ServiceManager.RegisterService( serviceCursors, 'Console cursor', CConsoleCursor);
  ServiceManager.RegisterService( serviceCursors, 'Spinner cursor', CSpinnerCursor);
  ServiceManager.RegisterService( serviceCursors, 'Xterm cursor', CXtermCursor );
end.
